Jack Colpitt

Import libaries

library(sf) # simple features for geometries          
library(rgdal) # OGR GeoJSON driver for importing data      
library(leaflet) # mapping visualization

Data Sources / Create Spatial Dataframes

The earthquake data is being pulled in through the real-time feed provided by the USGS https://www.usgs.gov/programs/earthquake-hazards/data.

Fault polylines are provided by esri in the ArcGIS Online (AGOL) living atlas

REST Page - https://services.arcgis.com/jIL9msH9OI208GCb/ArcGIS/rest/services/Active_Faults/FeatureServer/0

url <- "https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/2.5_month.geojson" # read geojson url into a variable
earthquakes <- readOGR(url, verbose=FALSE) # use the rgdal library to read the url into a SpatialPointsDataFrame
eqsf <- st_as_sf(earthquakes) # convert sp data into a simple features dataframe
# use the query tool in the REST page (set where clause to '1=1' to get all results) to generate a geojson request url
faults_url <- "https://services.arcgis.com/jIL9msH9OI208GCb/ArcGIS/rest/services/Active_Faults/FeatureServer/0/query?where=1%3D1&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&resultType=none&distance=0.0&units=esriSRUnit_Meter&relationParam=&returnGeodetic=false&outFields=*&returnGeometry=true&featureEncoding=esriDefault&multipatchOption=xyFootprint&maxAllowableOffset=&geometryPrecision=&outSR=&defaultSR=&datumTransformation=&applyVCSProjection=false&returnIdsOnly=false&returnUniqueIdsOnly=false&returnCountOnly=false&returnExtentOnly=false&returnQueryGeometry=false&returnDistinctValues=false&cacheHint=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&having=&resultOffset=&resultRecordCount=&returnZ=false&returnM=false&returnExceededLimitFeatures=true&quantizationParameters=&sqlFormat=none&f=pgeojson&token="
faults <-readOGR(faults_url, verbose=FALSE) # use the rgdal library to read the url into a SpatialPointsDataFrame
faults_sf <- st_as_sf(faults) # convert sp data into a simple features dataframe

Render leaflet map

The code below strings together multiple functions to render a complete web map with basemap options, class break symbology, pop-ups, layer toggling, and a legend. Lets walk through the steps…

- Set the R chunk options to ```{r, fig.width=9.5,fig.height=6} to display the width of the page.
- Use the colorBin function to create the class break symbology.
- Set the view.
- Add basemap tiles from CARTO and esri.
- Add Data.
- Configure pop-ups for earthquakes.
- Add legend and layer control.
# create class breaks with "Spectral" based on earthquake magnitude
pal <- colorBin(
  palette = "Spectral",
  domain = eqsf$mag, # use magnitude variable
  reverse = TRUE, # reverse the color direction
  bins = 5 # 5 breaks
)

leaflet() %>%
  setView(-117.841293, 46.195042, 3) %>% # set view to greater North America
  addProviderTiles(providers$CartoDB, group = "Grayscale") %>% # add CARTO tiles
  addProviderTiles(providers$Esri.WorldTerrain, group = "Terrain") %>% # add esri tiles
  addPolylines(data = faults_sf,
               popup = paste0( # create custom pop up
                 "<strong>Name:</strong> ", faults_sf$name,
                 "<br><strong>Slip Type:</strong> ", faults_sf$slip_type
                 ),
               group = "vectorData") %>% # add fault lines
  addCircleMarkers(data = eqsf, # create circle markers from earthquake data
                   fillColor = ~pal(mag), 
                   radius = ~eqsf$mag * 2,
                   stroke = FALSE,
                   color = "Spectral",
                   fillOpacity = 0.6,
                   popup = paste0( # create custum pop-ups
                     "<strong>Title:</strong> ", eqsf$title,
                     "<br><strong>Magnitude:</strong> ", eqsf$mag,
                     "<br><strong>Intensity:</strong> ", eqsf$mmi,
                     "<br><strong>Significanceq:</strong> ", eqsf$sig
                   ),
                   group = "vectorData") %>% 
  # add legend to the bottom left
  addLegend(pal = pal, values = eqsf$mag, position = "bottomleft", title = "Magnitude") %>%
  # create a layer toggle for the basemaps and vector data
  addLayersControl(overlayGroups = c("vectorData"), baseGroups = c("Terrain", "Grayscale"))

The options above from leaflet provide an interactive map with informational pop-ups for the recent seismic events and faults around the globe.

LS0tDQp0aXRsZTogIkVhcnRocXVha2UgJiBmYXVsdCB2aXN1YWxpemF0aW9uIHdpdGggTGVhZmxldCBmb3IgUiINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICBkZl9wcmludDogcGFnZWQNCi0tLQ0KIyMjIEphY2sgQ29scGl0dA0KDQoqIFRoZSBsZWFmbGV0IG1hcCBiZWxvdyB3aWxsIGJlIGxldmVyYWdpbmcgZ2VvcHNwYXRpYWwgbGlicmFyaWVzIGluIHRoZSBSIGVjb3N5c3RlbSB0byBkaXNwbGF5IGVhcnRocXVha2VzIHdpdGhpbiB0aGUgbGFzdCAzMCBkYXlzLiBGYXVsdHMgd2lsbCBhbHNvIGJlIGRpc3BsYXllZCB0byBnaXZlIGZ1cnRoZXIgaW5zaWdodHMgdG8gdGhlIGNsdXN0ZXJpbmcgb2Ygc2Vpc21pYyBldmVudHMuDQoNCiMjIyBJbXBvcnQgbGliYXJpZXMNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkoc2YpICMgc2ltcGxlIGZlYXR1cmVzIGZvciBnZW9tZXRyaWVzICAgICAgICAgIA0KbGlicmFyeShyZ2RhbCkgIyBPR1IgR2VvSlNPTiBkcml2ZXIgZm9yIGltcG9ydGluZyBkYXRhICAgICAgDQpsaWJyYXJ5KGxlYWZsZXQpICMgbWFwcGluZyB2aXN1YWxpemF0aW9uDQpgYGANCiMjIyBEYXRhIFNvdXJjZXMgLyBDcmVhdGUgU3BhdGlhbCBEYXRhZnJhbWVzDQoNCiMjIyMgIFRoZSBlYXJ0aHF1YWtlIGRhdGEgaXMgYmVpbmcgcHVsbGVkIGluIHRocm91Z2ggdGhlIHJlYWwtdGltZSBmZWVkIHByb3ZpZGVkIGJ5IHRoZSBVU0dTIGh0dHBzOi8vd3d3LnVzZ3MuZ292L3Byb2dyYW1zL2VhcnRocXVha2UtaGF6YXJkcy9kYXRhLg0KIyMjIyAgRmF1bHQgcG9seWxpbmVzIGFyZSBwcm92aWRlZCBieSBlc3JpIGluIHRoZSBBcmNHSVMgT25saW5lIChBR09MKSBsaXZpbmcgYXRsYXMgDQojIyMjIEFHT0wgLSBodHRwczovL3Blbm5zdGF0ZS5tYXBzLmFyY2dpcy5jb20vaG9tZS9pdGVtLmh0bWw/aWQ9MzdhMzg0ZDRjMWVmNGY1NmEzM2E0MGYyOTFhNjM0ZTkgDQojIyMjIFJFU1QgUGFnZSAtIGh0dHBzOi8vc2VydmljZXMuYXJjZ2lzLmNvbS9qSUw5bXNIOU9JMjA4R0NiL0FyY0dJUy9yZXN0L3NlcnZpY2VzL0FjdGl2ZV9GYXVsdHMvRmVhdHVyZVNlcnZlci8wDQpgYGB7cix3YXJuaW5nPUZBTFNFLG1lc3NhZ2U9RkFMU0V9DQp1cmwgPC0gImh0dHBzOi8vZWFydGhxdWFrZS51c2dzLmdvdi9lYXJ0aHF1YWtlcy9mZWVkL3YxLjAvc3VtbWFyeS8yLjVfbW9udGguZ2VvanNvbiIgIyByZWFkIGdlb2pzb24gdXJsIGludG8gYSB2YXJpYWJsZQ0KZWFydGhxdWFrZXMgPC0gcmVhZE9HUih1cmwsIHZlcmJvc2U9RkFMU0UpICMgdXNlIHRoZSByZ2RhbCBsaWJyYXJ5IHRvIHJlYWQgdGhlIHVybCBpbnRvIGEgU3BhdGlhbFBvaW50c0RhdGFGcmFtZQ0KZXFzZiA8LSBzdF9hc19zZihlYXJ0aHF1YWtlcykgIyBjb252ZXJ0IHNwIGRhdGEgaW50byBhIHNpbXBsZSBmZWF0dXJlcyBkYXRhZnJhbWUNCiMgdXNlIHRoZSBxdWVyeSB0b29sIGluIHRoZSBSRVNUIHBhZ2UgKHNldCB3aGVyZSBjbGF1c2UgdG8gJzE9MScgdG8gZ2V0IGFsbCByZXN1bHRzKSB0byBnZW5lcmF0ZSBhIGdlb2pzb24gcmVxdWVzdCB1cmwNCmZhdWx0c191cmwgPC0gImh0dHBzOi8vc2VydmljZXMuYXJjZ2lzLmNvbS9qSUw5bXNIOU9JMjA4R0NiL0FyY0dJUy9yZXN0L3NlcnZpY2VzL0FjdGl2ZV9GYXVsdHMvRmVhdHVyZVNlcnZlci8wL3F1ZXJ5P3doZXJlPTElM0QxJm9iamVjdElkcz0mdGltZT0mZ2VvbWV0cnk9Jmdlb21ldHJ5VHlwZT1lc3JpR2VvbWV0cnlFbnZlbG9wZSZpblNSPSZzcGF0aWFsUmVsPWVzcmlTcGF0aWFsUmVsSW50ZXJzZWN0cyZyZXN1bHRUeXBlPW5vbmUmZGlzdGFuY2U9MC4wJnVuaXRzPWVzcmlTUlVuaXRfTWV0ZXImcmVsYXRpb25QYXJhbT0mcmV0dXJuR2VvZGV0aWM9ZmFsc2Umb3V0RmllbGRzPSomcmV0dXJuR2VvbWV0cnk9dHJ1ZSZmZWF0dXJlRW5jb2Rpbmc9ZXNyaURlZmF1bHQmbXVsdGlwYXRjaE9wdGlvbj14eUZvb3RwcmludCZtYXhBbGxvd2FibGVPZmZzZXQ9Jmdlb21ldHJ5UHJlY2lzaW9uPSZvdXRTUj0mZGVmYXVsdFNSPSZkYXR1bVRyYW5zZm9ybWF0aW9uPSZhcHBseVZDU1Byb2plY3Rpb249ZmFsc2UmcmV0dXJuSWRzT25seT1mYWxzZSZyZXR1cm5VbmlxdWVJZHNPbmx5PWZhbHNlJnJldHVybkNvdW50T25seT1mYWxzZSZyZXR1cm5FeHRlbnRPbmx5PWZhbHNlJnJldHVyblF1ZXJ5R2VvbWV0cnk9ZmFsc2UmcmV0dXJuRGlzdGluY3RWYWx1ZXM9ZmFsc2UmY2FjaGVIaW50PWZhbHNlJm9yZGVyQnlGaWVsZHM9Jmdyb3VwQnlGaWVsZHNGb3JTdGF0aXN0aWNzPSZvdXRTdGF0aXN0aWNzPSZoYXZpbmc9JnJlc3VsdE9mZnNldD0mcmVzdWx0UmVjb3JkQ291bnQ9JnJldHVyblo9ZmFsc2UmcmV0dXJuTT1mYWxzZSZyZXR1cm5FeGNlZWRlZExpbWl0RmVhdHVyZXM9dHJ1ZSZxdWFudGl6YXRpb25QYXJhbWV0ZXJzPSZzcWxGb3JtYXQ9bm9uZSZmPXBnZW9qc29uJnRva2VuPSINCmZhdWx0cyA8LXJlYWRPR1IoZmF1bHRzX3VybCwgdmVyYm9zZT1GQUxTRSkgIyB1c2UgdGhlIHJnZGFsIGxpYnJhcnkgdG8gcmVhZCB0aGUgdXJsIGludG8gYSBTcGF0aWFsUG9pbnRzRGF0YUZyYW1lDQpmYXVsdHNfc2YgPC0gc3RfYXNfc2YoZmF1bHRzKSAjIGNvbnZlcnQgc3AgZGF0YSBpbnRvIGEgc2ltcGxlIGZlYXR1cmVzIGRhdGFmcmFtZQ0KYGBgDQojIyMgUmVuZGVyIGxlYWZsZXQgbWFwDQoNCiMjIyMgVGhlIGNvZGUgYmVsb3cgc3RyaW5ncyB0b2dldGhlciBtdWx0aXBsZSBmdW5jdGlvbnMgdG8gcmVuZGVyIGEgY29tcGxldGUgd2ViIG1hcCB3aXRoIGJhc2VtYXAgb3B0aW9ucywgY2xhc3MgYnJlYWsgc3ltYm9sb2d5LCBwb3AtdXBzLCBsYXllciB0b2dnbGluZywgYW5kIGEgbGVnZW5kLiBMZXRzIHdhbGsgdGhyb3VnaCB0aGUgc3RlcHMuLi4NCiMjIyMjIC0gU2V0IHRoZSBSIGNodW5rIG9wdGlvbnMgdG8gYGBge3IsIGZpZy53aWR0aD05LjUsZmlnLmhlaWdodD02fSB0byBkaXNwbGF5IHRoZSB3aWR0aCBvZiB0aGUgcGFnZS4NCiMjIyMjIC0gVXNlIHRoZSBjb2xvckJpbiBmdW5jdGlvbiB0byBjcmVhdGUgdGhlIGNsYXNzIGJyZWFrIHN5bWJvbG9neS4NCiMjIyMjIC0gU2V0IHRoZSB2aWV3Lg0KIyMjIyMgLSBBZGQgYmFzZW1hcCB0aWxlcyBmcm9tIENBUlRPIGFuZCBlc3JpLg0KIyMjIyMgLSBBZGQgRGF0YS4NCiMjIyMjIC0gQ29uZmlndXJlIHBvcC11cHMgZm9yIGVhcnRocXVha2VzLg0KIyMjIyMgLSBBZGQgbGVnZW5kIGFuZCBsYXllciBjb250cm9sLg0KYGBge3IsIGZpZy53aWR0aD05LjUsZmlnLmhlaWdodD02fQ0KIyBjcmVhdGUgY2xhc3MgYnJlYWtzIHdpdGggIlNwZWN0cmFsIiBiYXNlZCBvbiBlYXJ0aHF1YWtlIG1hZ25pdHVkZQ0KcGFsIDwtIGNvbG9yQmluKA0KICBwYWxldHRlID0gIlNwZWN0cmFsIiwNCiAgZG9tYWluID0gZXFzZiRtYWcsICMgdXNlIG1hZ25pdHVkZSB2YXJpYWJsZQ0KICByZXZlcnNlID0gVFJVRSwgIyByZXZlcnNlIHRoZSBjb2xvciBkaXJlY3Rpb24NCiAgYmlucyA9IDUgIyA1IGJyZWFrcw0KKQ0KDQpsZWFmbGV0KCkgJT4lDQogIHNldFZpZXcoLTExNy44NDEyOTMsIDQ2LjE5NTA0MiwgMykgJT4lICMgc2V0IHZpZXcgdG8gZ3JlYXRlciBOb3J0aCBBbWVyaWNhDQogIGFkZFByb3ZpZGVyVGlsZXMocHJvdmlkZXJzJENhcnRvREIsIGdyb3VwID0gIkdyYXlzY2FsZSIpICU+JSAjIGFkZCBDQVJUTyB0aWxlcw0KICBhZGRQcm92aWRlclRpbGVzKHByb3ZpZGVycyRFc3JpLldvcmxkVGVycmFpbiwgZ3JvdXAgPSAiVGVycmFpbiIpICU+JSAjIGFkZCBlc3JpIHRpbGVzDQogIGFkZFBvbHlsaW5lcyhkYXRhID0gZmF1bHRzX3NmLA0KICAgICAgICAgICAgICAgcG9wdXAgPSBwYXN0ZTAoICMgY3JlYXRlIGN1c3RvbSBwb3AgdXANCiAgICAgICAgICAgICAgICAgIjxzdHJvbmc+TmFtZTo8L3N0cm9uZz4gIiwgZmF1bHRzX3NmJG5hbWUsDQogICAgICAgICAgICAgICAgICI8YnI+PHN0cm9uZz5TbGlwIFR5cGU6PC9zdHJvbmc+ICIsIGZhdWx0c19zZiRzbGlwX3R5cGUNCiAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgIGdyb3VwID0gInZlY3RvckRhdGEiKSAlPiUgIyBhZGQgZmF1bHQgbGluZXMNCiAgYWRkQ2lyY2xlTWFya2VycyhkYXRhID0gZXFzZiwgIyBjcmVhdGUgY2lyY2xlIG1hcmtlcnMgZnJvbSBlYXJ0aHF1YWtlIGRhdGENCiAgICAgICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+cGFsKG1hZyksIA0KICAgICAgICAgICAgICAgICAgIHJhZGl1cyA9IH5lcXNmJG1hZyAqIDIsDQogICAgICAgICAgICAgICAgICAgc3Ryb2tlID0gRkFMU0UsDQogICAgICAgICAgICAgICAgICAgY29sb3IgPSAiU3BlY3RyYWwiLA0KICAgICAgICAgICAgICAgICAgIGZpbGxPcGFjaXR5ID0gMC42LA0KICAgICAgICAgICAgICAgICAgIHBvcHVwID0gcGFzdGUwKCAjIGNyZWF0ZSBjdXN0dW0gcG9wLXVwcw0KICAgICAgICAgICAgICAgICAgICAgIjxzdHJvbmc+VGl0bGU6PC9zdHJvbmc+ICIsIGVxc2YkdGl0bGUsDQogICAgICAgICAgICAgICAgICAgICAiPGJyPjxzdHJvbmc+TWFnbml0dWRlOjwvc3Ryb25nPiAiLCBlcXNmJG1hZywNCiAgICAgICAgICAgICAgICAgICAgICI8YnI+PHN0cm9uZz5JbnRlbnNpdHk6PC9zdHJvbmc+ICIsIGVxc2YkbW1pLA0KICAgICAgICAgICAgICAgICAgICAgIjxicj48c3Ryb25nPlNpZ25pZmljYW5jZXE6PC9zdHJvbmc+ICIsIGVxc2Ykc2lnDQogICAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgICAgICBncm91cCA9ICJ2ZWN0b3JEYXRhIikgJT4lIA0KICAjIGFkZCBsZWdlbmQgdG8gdGhlIGJvdHRvbSBsZWZ0DQogIGFkZExlZ2VuZChwYWwgPSBwYWwsIHZhbHVlcyA9IGVxc2YkbWFnLCBwb3NpdGlvbiA9ICJib3R0b21sZWZ0IiwgdGl0bGUgPSAiTWFnbml0dWRlIikgJT4lDQogICMgY3JlYXRlIGEgbGF5ZXIgdG9nZ2xlIGZvciB0aGUgYmFzZW1hcHMgYW5kIHZlY3RvciBkYXRhDQogIGFkZExheWVyc0NvbnRyb2wob3ZlcmxheUdyb3VwcyA9IGMoInZlY3RvckRhdGEiKSwgYmFzZUdyb3VwcyA9IGMoIlRlcnJhaW4iLCAiR3JheXNjYWxlIikpDQpgYGANCiMjIyMgVGhlIG9wdGlvbnMgYWJvdmUgZnJvbSBsZWFmbGV0IHByb3ZpZGUgYW4gaW50ZXJhY3RpdmUgbWFwIHdpdGggaW5mb3JtYXRpb25hbCBwb3AtdXBzIGZvciB0aGUgcmVjZW50IHNlaXNtaWMgZXZlbnRzIGFuZCBmYXVsdHMgYXJvdW5kIHRoZSBnbG9iZS4gDQo=